;;########################################################################
;; sprdplt2.lsp - from update\enhance-sprdplt2.lsp
;; Copyright (c) 1996-2002 by Forrest W. Young, Richard A. Faldowski, & Carla Bann
;;########################################################################  


#|
changes in spreadplot menuing by fwy 20010329

*current-spreadplot*           no longer used
*desktop-spreadplot-menu-item* no longer used
*open-spreadplots*   list of all open/hid but not closed spreadplots objects
                     rather than list of all open but not hid/closed splots
statobj-menu-item  new slot for statistical object menu item object id

same as before:
window-menu-item   old slot for window menu item object id
menu               old slot for spreadplot's menubar "window" menu item

Change in data and model menus
1) changed visualize data/model so that dialog is only for new spreadplot choices 
   (remove the dialog item list of spreadplots which is all previously created
   spreadplots, no matter which object created and whether open, hid, or closed).

Changes in desktop window and help menus
1) removed spreadplot and report items from desktop's window menu
2) added dash followed by list of all existing spreadplots
3) Removed remnants of *help-menu* spreadplot items

Changes in spreadplot's window menu. It has these items
2) spreadplot's window menu is
   DeskTop Window
   XlispStat Window
   Report Window
   ------------ (no report or spreadplot window)
   Copy SpreadPlot
   Print SpreadPlot
   Refresh SpreadPlot
   Restore SpreeaPlot (puts popped outs back in)
   

Contemplated changes in data and model menus and popup menus
1) When click on a graph-icon on workmap, pop-up menu of new and previous
   graphs specific to the type of statistical object.
2) change preferences to toggle long menus to be either
   a) off
   b) statobjs
   c) spreadplots
3) when preferneces indicate to do so, then at end of menu  
   append menu item list of *co*'s existing spreadplots


When new spreadplot made:
1) add menu item to bottom of desktop window menu
2) create spreadplot's window menu
3) create menu item for the data/model object's list of splot menu-items
4) add menu items to bottom of each plot-cell's menu for
   save-spreadplot
   print-spreadplot
   pop-out/put-in plot
   maximize/restore plot

** don't add menu items or menus anywhere else 
** no spreadplot menu

When data/model menu is used:
1) Add menu items for data/model object

|#



(defmeth spreadplot-proto :calculate-splot-size ()
  (let* ((array-size (array-dimensions (send self :sizes-matrix)))
         (low-right-loc (aref (send self :locations-matrix) 
                             (1- (first array-size)) 
                             (1- (second array-size))))
         (low-right-size (aref (send self :sizes-matrix) 
                             (1- (first array-size)) 
                             (1- (second array-size))))
         (size (+ low-right-loc low-right-size))
         (supplot (send self :supplemental-plot))
         )
    (when supplot 
          (when (not (kind-of-p supplot dialog-proto))
                (setf size (+ size (list (first (send supplot :size)) 0)))))
    (send self :size size)
    size))


(defmeth spreadplot-proto :bring-to-top ()
  (send (send self :container) :show-window)
  (send (send self :container) :top-most t)
  (send (send self :container) :top-most nil))

(defmeth spreadplot-proto :locations ()
"Method Args:  NONE
Retrieves the spreadplot's list of plot locations (including supplemental plot)."
  (let* ((mat (send self :locations-matrix))
         (suplot (send self :supplemental-plot))
         (n (prod (array-dimensions mat)))
         (matlist (coerce (make-array (list n) :displaced-to mat) 'list)))
  (if suplot (append matlist (list (send suplot :location))) matlist)))


(defmeth spreadplot-proto :sizes ()
"Method Args:  NONE
Retrieves the sizes of all plots (including supplemental plot) as a list."
  (let* ((mat (send self :sizes-matrix))
         (suplot (send self :supplemental-plot))
         (n (prod (array-dimensions mat)))
         (matlist (coerce (make-array (list n) :displaced-to mat) 'list)))
    (if suplot (append matlist (list (send suplot :size))) matlist)))


(defmeth spreadplot-proto :make-link-list (plots)
"Limits plot linkage to the plots in this spreadplot"
  (mapcar #'(lambda (plot)
              (defmeth plot :links ()
                (let ((link-list (send (send plot :spreadplot-object) :link-list)))
                  (if (member self link-list) link-list)))
              (defmeth plot :linked (&optional (link nil set))
                (let ((link-list (send (send plot :spreadplot-object) :link-list)))
                  (when set (setf link-list (if link (cons self link-list) 
                                                (remove self link-list)))
                        (send (send plot :spreadplot-object) :link-list link-list)
                        (call-next-method link))
                  (call-next-method)))
              )
          plots))

(defun spreadplot-help ()
  (if *current-spreadplot*
      (send *current-spreadplot* :spreadplot-help)))

(defmeth spreadplot-proto :spreadplot-help 
  (&key (flush t) skip nothing points bars labels )

  (plot-help-window (strcat "SpreadPlot Help") :flush t)
  (when (not skip)
        (when (or points bars labels)
              (paste-plot-help (format nil
"The ~a~a~a~a~a in the windows of this spreadplot are linked together. When you brush or click on them in one window, the corresponding objects in other windows are also highlighted. These objects are linked together because they represent the same observations in your data. By looking for the structure revealed in each window you can get a better understanding of your data.~2%" (if points "points" "") 
(if (and points bars labels) "," " ")
(if bars " bars " "") 
(if (or (and points bars) (and points labels) (and bars labels)) "and " "")
(if labels "labels" "")))) 
    
        (when nothing
              (paste-plot-help (format nil "There are no other linkage features of this SpreadPlot. The general help about SpreadPlots is given in the remainer of this window.~2%")))
        )
  (paste-plot-help (format nil "GENERAL SPREADPLOT HELP~2%"))
  ;(show-plot-help) ;do we need this? nooo ... just makes it blink!
  ;(call-next-method :flush nil)
  (send graph-window-proto :spreadplot-help :flush nil));in graphelp

(defmeth spreadplot-proto :update-spreadplot (i j &rest args)
"Method Args: I J &REST ARGS &KEY USE-STATOBJ
This message is sent by an individual plot or by a statistical object to the spreadplot. When USE-STATOBJ is T the message is relayed to the statistical object which processes it and sends the results back via annother UPDATE-SPREADPLOT message with the same values for indices I and J, new ARGS, and USE-STATOBJ NIL. When USE-STATOBJ is NIL, the message is broadcast via the update-plotcell message to all plots so that they can update themselves. The arguments I and J are two numbers which identify the message uniquely (often this is the row and column of the sending plotcell, but if a plotcell can send more than one type of message than another identifing method must be used, such as plot number and message number). All of the REST arguments must be a union of arguments needed by all receiving plotcells, each of which must decide which arguments it needs."
  (if (symbolp (first args))
      (when (string-equal (first args) "USE-STATOBJ")
            (when (second args)
                  (let* ((statobj (send self :statistical-object))
                         (hasmeth (send statobj :has-method 'update-statobj))
                         )
                    (unless hasmeth
                            (defmeth statobj :update-statobj (i j args)
                              (send self :update-from-spreadplot i j args)))
                    (send statobj :update-statobj i j nil))))
      (mapcar #'(lambda (plot)
                  (send plot :update-plotcell i j args))
              (send self :all-plots))))
  

(defmeth spreadplot-proto :create-container-menus ()
  (let* ((plot-help-menu-item))
    (setf *spreadplot-help-menu*   (send menu-proto :new "Help"))
    (setf *spreadplot-window-menu* (send menu-proto :new "Window"))
    (send *spreadplot-help-menu* :append-items 
           (send menu-item-proto :new "SpreadPlot Help"
                 :action 'spreadplot-help)
           (send dash-item-proto :new))
    (mapcar #'(lambda (plot)
                (when plot
                    (when (send plot :has-slot 'plot-help-menu)
                          (setf plot-help-menu-item 
                                (send plot :slot-value 'plot-help-menu))
                          (send plot :remove-plot-help-item)
                          (send *spreadplot-help-menu* :append-items
                                plot-help-menu-item))))
          (send self :all-plots))
  (send *spreadplot-window-menu* :append-items
          (send menu-item-proto :new "Show Report Window" :action 'report)
          (send menu-item-proto :new "Show DeskTop Window" :action 'show-desktop)
          (send menu-item-proto :new "Show Listener Window" :action 'show-listener)
          (send dash-item-proto :new)
          (send menu-item-proto :new "Refresh SpreadPlot"
                :action 'refresh-spreadplot)
          )
  
  (send *spreadplot-window-menu* :install)
  (send *spreadplot-help-menu* :install)
  t))
  
 
(defmeth spreadplot-proto :create-menu 
  (&optional title  &key (items (send self :menu-template)) ) 
  (unless title (setq title (slot-value 'menu-title)) )
  (setf *spreadplot-help-menu* (send menu-proto :new "Help"))
  (send self :menu *spreadplot-help-menu* )
  (send *spreadplot-help-menu* :append-items
        (send menu-item-proto :new "SpreadPlot Help"
              :action 'spreadplot-help)
        (send dash-item-proto :new))
  (mapcar #'(lambda (plot)
              (when plot
                    (send plot :add-spreadplot-help-item)))
          (send self :all-plots))
  (setf *spreadplot-window-menu* (send menu-proto :new "Window"))
  (send *spreadplot-window-menu* :append-items
        (send expert-menu-item-proto :new "DeskTop Window"
              :action #'(lambda () (desktop-window)))
        (send expert-menu-item-proto :new "XLispStat Window"
                :action #'(lambda () (xlispstat-window)))
        (send expert-menu-item-proto :new "ViVa Window"
            :action #'(lambda () (viva-window)))
	;(send expert-menu-item-proto :new "GraphFrame Window"
        ;    :action #'(lambda () (GraphFrame-window)))
        (send dash-item-proto :new)
        (send expert-menu-item-proto :new "Current DataSheet Window" 
              :action #'(lambda () (edit-data)))
        (send expert-menu-item-proto :new "Current Report Window" 
              :action 'current-report)
	;(send expert-menu-item-proto :new "Current SpreadPlot Window"
        ;    :action #'(lambda () (spreadplot-window)))
        (send dash-item-proto :new)
        (send menu-item-proto :new "Print SpreadPlot"
              :action #'(lambda () 
                          (print-spreadplot)))
        (send menu-item-proto :new "Save SpreadPlot As ..."
              :action #'(lambda () 
                          (save-spreadplot)))
        (send menu-item-proto :new "Copy SpreadPlot"
              :action #'(lambda () 
                          (copy-spreadplot)))
        )
  (mapcar #'(lambda (plot)
              (let* ((menu? (send plot :menu))
                     (menu  (if menu? (send plot :menu) (send menu-proto :new "Plot Menu")))
                     (items (if menu? (send menu :items) nil)))
                (when items (apply #'send menu :delete-items items))
                (send menu :append-items
                      (send menu-item-proto :new "SpreadPlot Help" 
                            :action #'(lambda () 
                                        (send (send (send self :spreadplot) 
                                                    :container):plot-help))))
                (when (and menu? (equal "Help" (send (first items) :title)))
                      (send (first items) :title "Plot Help"))
                (when menu? (apply #'send menu :append-items items))

                (unless menu?
                        (send menu :append-items
                              (send dash-item-proto :new)
                              (send menu-item-proto :new "Print Plot" 
                                    :action #'(lambda ()
                                                (send plot :ask-print-pdf)))
                              (send menu-item-proto :new "Save Plot As ..." 
                                    :action #'(lambda ()
                                                (send plot :ask-save-pdf)))
                              (send menu-item-proto :new "Copy Plot" 
                                    :action #'(lambda ()
                                                (send plot :do-msw-copy)))))
                (send menu :append-items
                      (send dash-item-proto :new)
                      (send menu-item-proto :new "Print SpreadPlot"
                            :action #'(lambda () 
                                        (print-spreadplot)))
                      (send menu-item-proto :new "Save SpreadPlot As ..."
                            :action #'(lambda () 
                                        (save-spreadplot)))
                      (send menu-item-proto :new "Copy SpreadPlot"
                            :action #'(lambda () 
                                        (copy-spreadplot))))
                ))
          (send self :all-plots nil))
  (send *spreadplot-window-menu* :install)
  (send *spreadplot-help-menu* :install)
  *spreadplot-help-menu*)

(defmeth spreadplot-proto :print-spreadplot   () (pdf-container-print))
(defmeth spreadplot-proto :save-spreadplot-as () (pdf-container-save))
(defmeth spreadplot-proto :copy-spreadplot    () (msw-container-copy))

(defun print-spreadplot   () (pdf-container-print))
(defun save-spreadplot-as () (pdf-container-save))
(defun copy-spreadplot    () (msw-container-copy))

(defun pdf-container-print ()
  (when (two-button-dialog (format nil "Print window as PDF not yet available.~%Print Bitmap Image Instead?"))
        (msw-container-print)))

(defun pdf-container-save ()
  (when (two-button-dialog (format nil "Save Image as aPDF file not yet available.~%Copy Bitmap Image to Clipboard Instead?"))
        (msw-container-copy)))


(defmeth window-proto :add-spreadplot-help-item  (&optional (title))
  (let* ((g self)
         (title2 (if title title (send g :title)))
         (m (send menu-item-proto :new (if title2 title2 "PlotHelp")
                  :action '(lambda ()
                      (send (send self :slot-value 'plot-obj) :plot-help)))))
    (send m :add-slot 'plot-obj g)
    (send g :add-slot 'plot-help-menu m)
    (unless (send g :has-slot 'spreadplot-object)
            (send g :add-slot 'spreadplot-object)
            (defmeth g :spreadplot-object (&optional (obj nil set))
              (if set (setf (slot-value 'spreadplot-object) obj))
              (slot-value 'spreadplot-object)))

    (when (and *current-spreadplot* (send g :spreadplot-object))
          (send *spreadplot-help-menu*  :append-items m))
    (defmeth g :remove ()
      (send g :remove-plot-help-item)
      (call-next-method))
    m))

  


(defun refresh-spreadplot ()
  (send *current-spreadplot* :refresh-spreadplot))

(defmeth spreadplot-proto :refresh-spreadplot ()
  (let* ((plot-list)
         (plot-matrix (send self :plot-matrix))
         (location-list (send self :locations))
         (supplot (send self :supplemental-plot))
         (size-list (send self :sizes))
         (L 0)
         )
    (dotimes (i (first (size plot-matrix)))
             (dotimes (j (second (size plot-matrix)))
                      (setf plot-list (aref plot-matrix i j))
                      (if (not (listp plot-list))
                          (setf plot-list (list plot-list)))
                      (dotimes (k (length plot-list))
                               (apply #'send (select plot-list k) :location 
                                      (select location-list L))
                               (apply #'send (select plot-list k) :size
                                      (select size-list L)))
                      (setf L (1+ L))))
    (when supplot (apply #'send supplot :location (send self :suploc)))
    (send self :show-visible-plots)))


;This one is the one being used

(defmeth spreadplot-proto :make-spreadplot-container-resize (container)
  (let ((spreadplot self))
    (send container :idle-on nil)
    (send container :add-slot 'spreadplot spreadplot)
    (defmeth container :spreadplot (&optional (objid nil set))
      (if set (setf (slot-value 'spreadplot) objid))
      (slot-value 'spreadplot))
    (defmeth container :resize ()
      (send container :resize-it))
    (defmeth container :resize-it ()
      (cond
        ((send container :idle-on) )
        (t 
         (mapcar #'(lambda (plot) 
                     (defmeth plot :redraw ()))
                 (send spreadplot :all-plots))
         (send container :idle-on t))))
    (defmeth container :do-idle ()
      (send container :idle-on nil)
      (mapcar #'(lambda (plot) 
                  (defmeth plot :redraw ()
                    (call-next-method)))
              (send spreadplot :all-plots))
      (send spreadplot :resize-it))
    (defmeth spreadplot :resize-it ()
      (send spreadplot :screen-size (send container :size))
      (send spreadplot :create-spreadplot)
      (defmeth container :resize ())
      (send container :fix-splot-size (send container :size))
      (send spreadplot :resize)
      (apply #'send container :size (+ '(4 22) (send spreadplot :size)));0 20
      (send spreadplot :size (send container :size))
      (defmeth container :resize ()
        (send self :resize-it))
      )
    ))


(defmeth container-proto :fix-splot-size (&optional max-size splot?)
  (let* ((max (if max-size max-size (- (effective-screen-size) '(0 20))))
         (screen-ar (/ (first max) (second max)))
         (object (if splot? (send self :spreadplot-object) self))
         (act (send object :size))
         (splot-ar (/ (first act) (second act)))
         (rat (if (< screen-ar splot-ar)
                  (/ (first max) (first act))
                  (/ (second max) (second act))))
         (size (floor (* rat (- act '(15 15)))))
         )
    (send (send self :spreadplot-object) :size size)
    size))

(defmeth spreadplot-proto :all-plots (&optional (suplot t))
"Method Args: () 
Returns a list of all plots." 
  (if (and suplot (send self :supplemental-plot) )
      (combine (send self :plot-matrix) (send self :supplemental-plot) )
      (combine (send self :plot-matrix))))

(defmeth spreadplot-proto :hide-all-plots ()
  (mapcar #'(lambda (x) 
              (send x :remove-plot-help-item)
              (send x :hide-window)) 
          (send self :all-plots)))


(defmeth spreadplot-proto :close-all-plots ()
  (mapcar #'(lambda (x) 
              (send x :remove-plot-help-item)
              (send x :remove)) 
          (send self :all-plots)))

(defmeth spreadplot-proto :show-visible-plots ()
  (mapcar #'(lambda (x) 
              (send x :show-window)(send x :redraw)) 
          (send self :all-plots nil)))


(defmeth spreadplot-proto :show-visible-plots ()
  (let* ((spans (combine (+ (send self :span-right)
                            (send self :span-down ))))
         )
    (when (send self :supplemental-plot)
          (setf spans (combine spans 1)))
    (mapcar #'(lambda (x span-val) 
                (unless (= span-val 0)
                        (send x :show-window)
                        ))
            (send self :all-plots t) spans)))

(defun show-spreadplot () 
  (if *current-spreadplot* 
      (send *current-spreadplot* :show-window)
      (if *current-object* 
          (send *current-object* :visualize)
          (vista-dialog "No Object to Visualize"))))


;new method fwy 20010329
;(NO front-window METHOD FOR THIS PROTO PREVIOUSLY)
#+containers
(defmeth spreadplot-proto :front-window ()
  (send self :show-window))

;new method fwy 20010329
(defmeth spreadplot-proto :close-spreadplot ()
  (send self :hide-spreadplot t))

#+containers
(defmeth spreadplot-proto :show-window ()
 (cond ((send (send self :container) :allocated-p) 
        (enable-container (send self :container))
        (send (send self :container) :front-window)
       ; (send self :show-spreadplot)
        )
   (t (vista-dialog "SpreadPlot Has Been Closed and Removed."))))

;changed by fwy 20010329 - didnt work before 
(defmeth spreadplot-proto :show-spreadplot ()
"Method Args: () DID NOT WORK
Shows the spreadplot. This involves showing the individual plots installed in the spreadplot, enables the refresh spreadplot menu item, installs menu items in help menu, and installs the spreadplot menu (if it has one) into the menu bar."
  (cond 
    ((send self :ever-shown?)
     (send self :front-window))
    (t
     (send self :show-new-spreadplot)
     (send self :ever-shown? t)))
  (setf *current-spreadplot* self)
  (send self :showing t)
  (push self *open-spreadplots*)
  (when (send self :menu) (send (send self :menu) :install)))

(defmeth spreadplot-proto :show-new-spreadplot ()
  (refresh-spreadplot)
  (let* ((container (send self :container))
         (cont-size (send container :fix-splot-size nil t))
         )
    (apply #'send container :location (send *vista* :workmap-location))
    (apply #'send container :size cont-size)
    (send self :screen-size cont-size)
    (send self :create-spreadplot)
    (apply #'send container :size (+ '(4 22) (send self :size)));0 20
    (send container :show-spreadplot)
    (refresh-spreadplot)
    (send self :make-spreadplot-container-resize container)
    ))

(defmeth spreadplot-proto :hide-spreadplot ()
"Method Args: () 
Hides the spreadplot.  First, removes its menu (if it has one) from the menu bar.  Then, hides the individual plots installed in it. "
  (when (send self :menu) (send (send self :menu) :remove) )
  (send self :showing nil)
  (setf *open-spreadplots* (remove self *open-spreadplots* :test #'equal))
  (cond
    (*open-spreadplots*
     (setf *current-spreadplot* (first *open-spreadplots*))
     )
    (t
     (setf *current-spreadplot* nil)
     (send *desktop-spreadplot-menu-item* :enabled nil)))
  (when (equal *current-object* *current-data*)
        (send *vista*   :show-labels)
        (send *vista* :show-obs))
  (send self :hide-all-plots)
  (if (equal (send (first (last (send *help-menu* :items))) :title) "-")
        (send *help-menu* :delete-items (first (last (send *help-menu* :items)))))
  (send *workmap* :reset-screen-saver)
  (send *watcher* :close)
  )

(defmeth spreadplot-proto :resize ()
  (send self :create-spreadplot))

(defmeth spreadplot-proto :remove ()
"Method Args: () 
Removes the spreadplot.  First, remove its menu if it has one.  Then, remove the individual plots installed in it. "
  
  (when (send self :menu)
        (send (send self :menu) :remove)
        (send (send self :menu) :dispose) )
  (when (find (send self :window-menu-item) (send *desktop-window-menu* :items))
        (send *desktop-window-menu* :delete-items
              (send self :window-menu-item)))
  
  (mapcar #'(lambda (plot) 
              (when plot
                    (if (send plot :allocated-p)
                        (send plot :remove))))
              (send self :all-plots)) )


(defmeth spreadplot-proto :close ()
  (send (send self :container) :close)
  (send self :remove))